The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
Changes 06
MANIFEST 10
META.yml 24
Makefile.PL 10
SIGNATURE 420
lib/Catalyst/Plugin/Cache/Curried.pm 513
lib/Catalyst/Plugin/Cache.pm 746
t/basic.t 09
8 files changed (This is a version diff) 5878
@@ -1,3 +1,9 @@
+0.09
+        - Generate a warning if no config is specified, or config
+          is specified using the old key.
+        - Support the compute() method, and emulate it if the backend
+          doesn't have it.
+
 0.08
         - Forgot to add MRO::Compat to Makefile.PL, fail.
 
@@ -17,4 +17,3 @@ t/lib/CacheTestApp.pm
 t/lib/CacheTestApp/Controller/Root.pm
 t/live_app.t
 META.yml                                 Module meta-data (added by MakeMaker)
-SIGNATURE                                Public-key signature (added by MakeMaker)
@@ -1,12 +1,14 @@
 --- #YAML:1.0
 name:               Catalyst-Plugin-Cache
-version:            0.08
+version:            0.09
 abstract:           ~
 author:  []
 license:            unknown
 distribution_type:  module
 configure_requires:
     ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
 requires:
     Catalyst:         5.7
     MRO::Compat:      0
@@ -20,7 +22,7 @@ no_index:
     directory:
         - t
         - inc
-generated_by:       ExtUtils::MakeMaker version 6.48
+generated_by:       ExtUtils::MakeMaker version 6.54
 meta-spec:
     url:      http://module-build.sourceforge.net/META-spec-v1.4.html
     version:  1.4
@@ -15,5 +15,4 @@ WriteMakefile(
     'INSTALLDIRS' => 'site',
     'EXE_FILES'   => [],
     'PL_FILES'    => {},
-    'SIGN'        => 1,
 );
@@ -1,42 +0,0 @@
-This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.54.
-
-To verify the content in this distribution, first make sure you have
-Module::Signature installed, then type:
-
-    % cpansign -v
-
-It will check each file's integrity, as well as the signature's
-validity.  If "==> Signature verified OK! <==" is not displayed,
-the distribution may already have been compromised, and you should
-not run its Makefile.PL or Build.PL.
-
------BEGIN PGP SIGNED MESSAGE-----
-Hash: SHA1
-
-SHA1 2f2bf6a1065e03e3f87ceb0128938f56ded663a3 Changes
-SHA1 1976c14603c9c87d1c90c688e6246c05003ee538 MANIFEST
-SHA1 0c816c13f1c8d693df25d017ea94e18fe238ffad META.yml
-SHA1 dc3637be9fb1095f5daba4302525ec054553ca51 Makefile.PL
-SHA1 286e3fdd61eb8f43c88115eba7534bf2a389c157 lib/Catalyst/Plugin/Cache.pm
-SHA1 8ebedad7e3ac382a0de7cd2859388a50f6c04cbe lib/Catalyst/Plugin/Cache/Backend.pm
-SHA1 6221c0869bf1bdee6c0534f64f48612164771216 lib/Catalyst/Plugin/Cache/Backend/Memory.pm
-SHA1 c69a308e86f0577b7932a87a453d1b62f8b96f13 lib/Catalyst/Plugin/Cache/Choose/KeyRegexes.pm
-SHA1 a064c8b6d5ad2d4ec01def1451b91db97a2e94db lib/Catalyst/Plugin/Cache/Curried.pm
-SHA1 ce22940b8437e92ec1f0586d526b3fceaae6f480 lib/Catalyst/Plugin/Cache/Store.pod
-SHA1 64c6a90c3362e65f84a1af483046a4aa83b88431 lib/Catalyst/Plugin/Cache/Store/Memory.pm
-SHA1 0f90144b3b1e7aa5620f1360132cd77d8004d9d6 t/basic.t
-SHA1 b5daf88452048a6455cab25e95f5077a7448d053 t/config_backend_class.t
-SHA1 a878e458b8eb1a5a653409f7421dbc49427eeb0e t/config_guess_backend.t
-SHA1 d0976fe7775f253d24050cc7d9227c6716e42562 t/currying_conf.t
-SHA1 08b27233c17e55fb39b2d22d3ae7dc6053c13707 t/key_regexes.t
-SHA1 b6a382072e97d5c7600880935be80c843ea50a5d t/lib/CacheTestApp.pm
-SHA1 20d3480bf50d6673622db06805ad050e206ed0f4 t/lib/CacheTestApp/Controller/Root.pm
-SHA1 5560f5ece751ddb4cf4602447c4fdf4ec6a6ee4d t/live_app.t
------BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.1 (Darwin)
-
-iD8DBQFJkU7Hqiut6GtTojsRAg43AJ9++FUcAhHVe8Kqnak8hkwvfuIQ9QCeM8Fl
-UQwKekta5OIKYLIx1vxOqAg=
-=E7zQ
------END PGP SIGNATURE-----
@@ -36,15 +36,21 @@ sub set {
 }
 
 sub get {
-    my ( $self, $key, @meta ) = @_;
+    my ( $self, $key ) = @_;
     $self->c->cache_get( $key, @{ $self->meta } );
 }
 
 sub remove {
-    my ( $self, $key, @meta ) = @_;
+    my ( $self, $key ) = @_;
     $self->c->cache_remove( $key, @{ $self->meta } );
 }
 
+sub compute {
+    my ($self, $key, $code, @meta) = @_;
+    @meta = ( expires => $meta[0] ) if @meta == 1;
+    $self->c->cache_compute( $key, $code, @{ $self->meta }, @meta );
+}
+
 __PACKAGE__;
 
 __END__
@@ -85,9 +91,11 @@ the additional meta.
 
 =item remove $key, %additional_meta
 
-Dellegate to the C<c> object's C<cache_set>, C<cache_get> or C<cache_remove>
-with the arguments, then the captured meta from C<meta>, and then the
-additional meta.
+=item compute $key, $code, %additional_meta
+
+Dellegate to the C<c> object's C<cache_set>, C<cache_get>, C<cache_remove>
+or C<cache_compute> with the arguments, then the captured meta from C<meta>,
+and then the additional meta.
 
 =item meta
 
@@ -6,7 +6,7 @@ use base qw(Class::Accessor::Fast Class::Data::Inheritable);
 use strict;
 use warnings;
 
-our $VERSION = "0.08";
+our $VERSION = "0.09";
 
 use Scalar::Util ();
 use Catalyst::Utils ();
@@ -31,10 +31,23 @@ sub setup {
 
     $ret;
 }
-
-sub _get_cache_plugin_config {
-    my ($app) = @_;
-    return $app->config->{'Plugin::Cache'} || $app->config->{cache};
+{
+    my %has_warned_for;
+    sub _get_cache_plugin_config {
+        my ($app) = @_;
+        my $config = $app->config->{'Plugin::Cache'};
+        if (!$config) {
+            $config = $app->config->{cache};
+            my $appname = ref($app);
+            if (! $has_warned_for{$appname}++ ) {
+                $app->log->warn($config ?
+                    'Catalyst::Plugin::Cache config found in deprecated $c->config->{cache}, please move to $c->config->{"Plugin::Cache"}.'
+                    : 'Catalyst::Plugin::Cache config not found, using empty config!'
+                );
+            }
+        }
+        return $config || {};
+    }
 }
 
 sub get_default_cache_backend_config {
@@ -54,7 +67,7 @@ sub setup_cache_backends {
     $app->maybe::next::method;
 
     # FIXME - Don't know why the _get_cache_plugin_config method doesn't work here!
-    my $conf = $app->config->{'Plugin::Cache'} ? $app->config->{'Plugin::Cache'}->{backends} : $app->config->{cache}->{backends};
+    my $conf = $app->_get_cache_plugin_config->{backends};
     foreach my $name ( keys %$conf ) {
         next if $app->get_cache_backend( $name );
         $app->setup_generic_cache_backend( $name, $app->get_cache_backend_config( $name ) || {} );
@@ -288,6 +301,24 @@ sub cache_remove {
     $c->choose_cache_backend_wrapper( key => $key, @meta )->remove( $key );
 }
 
+sub cache_compute {
+    my ($c, $key, $code, %meta) = @_;
+
+    my $backend = $c->choose_cache_backend_wrapper( key =>  $key, %meta );
+    if ($backend->can('compute')) {
+        return $backend->compute( $key, $code, exists $meta{expires} ? $meta{expires} : () );
+    }
+
+    Carp::croak "must specify key and code" unless defined($key) && defined($code);
+
+    my $value = $c->cache_get( $key, %meta );
+    if ( !defined $value ) {
+        $value = $code->();
+        $c->cache_set( $key, $value, %meta );
+    }
+    return $value;
+}
+
 __PACKAGE__;
 
 __END__
@@ -375,8 +406,16 @@ See L</METADATA> for details.
 
 =item cache_remove $key, %meta
 
+=item cache_compute $key, $code, %meta
+
 These cache operations will call L<choose_cache_backend> with %meta, and
-then call C<set>, C<get>, or C<remove> on the resulting backend object.
+then call C<set>, C<get>, C<remove>, or C<compute> on the resulting backend
+object.
+
+If the backend object does not support C<compute> then we emulate it by
+calling L<cache_get>, and if the returned value is undefined we call the passed
+code reference, stores the returned value with L<cache_set>, and then returns
+the value.  Inspired by L<CHI>.
 
 =item choose_cache_backend %meta
 
@@ -93,3 +93,12 @@ my $cache_norm = $c->cache();
 
 is( $cache_norm->get("foo"), undef, "default curried cache has no foo");
 is( $cache_elk->get("foo"), "gorch", "curried custom backend has foo" );
+
+
+is( $c->cache->get('compute_test'), undef, 'compute_test key is undef by default' );
+is( $c->cache->compute('compute_test',sub{'monkey'}), 'monkey', 'compute returned code value' );
+is( $c->cache->get('compute_test'), 'monkey', 'compute_test key is now set' );
+is( $c->cache->compute('compute_test',sub{'donkey'}), 'monkey', 'compute returned cached value' );
+$c->cache->remove('compute_test');
+is( $c->cache->compute('compute_test',sub{'donkey'}), 'donkey', 'compute returned second code value' );
+